(**
 * Utility functions for formatting using SMLFormat.
 * @copyright (C) 2021 SML# Development Team.
 * @author Atsushi Ohori 
 * @version $Id: SmlppgUtil.ppg,v 1.1 2008/06/13 04:14:10 ohori Exp $
 *)
structure SmlppgUtil =
struct
  type format = SMLFormat.FormatExpression.expression list

  (***************************************************************************)

  structure FE = SMLFormat.FormatExpression

  (***************************************************************************)

  val s_d_Indicator =
      FE.Indicator
      {space = true, newline = SOME{priority = FE.Deferred}}

  fun makeToken s = [FE.Term (String.size s, s)]

  fun format_int32 int =
      let val text = Int32.toString int
      in [FE.Term (size text, text)] end

  fun format_word32 word =
      let val text = Word32.toString word
      in [FE.Term (size text, text)] end

  fun format_IntInf int =
      let val text = IntInf.toString int
      in [FE.Term (size text, text)] end

  local
    (**
     * @params isTyConArguments args
     * @param isTyConArguments true if this function is called to format type
     *        arguments to type constructor.
     * @param args a pair of element formatter, separator, prefix and suffix.
     *)
    fun formatElements
            isTyConArguments
            (elementFormatter, separator, prefixIfNotNull, suffixIfNotNull) =
        fn [] => [FE.Term (0, "")]
         | [e] =>
           if isTyConArguments
           then
             (* guard the element as:
              *   N3{ elem }
              * This assumes this function is called to format type arguments
              * of type constructor.
              *)
             [
               FE.Guard 
                   (
                     SOME{cut = false, strength = 3, direction = FE.Neutral},
                     elementFormatter e
                   ),
               s_d_Indicator
             ]
           else (elementFormatter e) (*@ [s_d_Indicator]*)
         | list =>
           FE.Sequence prefixIfNotNull
           :: FE.Guard 
                (
                  SOME{cut = true, strength = 0, direction = FE.Neutral},
                  (SMLFormat.BasicFormatters.format_list
                     (elementFormatter, separator) list)
                )
           :: suffixIfNotNull
  in
  fun formatTyConArgumentTypes arguments = formatElements true arguments
  fun formatListWithEnclosureOne arguments = formatElements false arguments
  end

  (*
    This is for the usual list printing, u.e.
      nil => ""
      non nil => [e1,...,en] 
   *)
  fun formatListWithEnclosure
      (elementFormatter, separator, prefixIfNotNull, suffixIfNotNull) =
      fn [] => nil
       | list =>
         FE.Sequence prefixIfNotNull ::
         FE.Sequence (SMLFormat.BasicFormatters.format_list
                         (elementFormatter, separator) list) ::
         suffixIfNotNull

  (*
    This is for the following printing
      nil => ""
      [e] => e
      [e1,...,en] => opne e1 sep e2 sep ... sep en close
   *)
  fun formatListWithEnclosureIfMoreThanOne
      (elementFormatter, separator, prefixIfNotNull, suffixIfNotNull) =
      fn [] => [FE.Term (0, "")]
       | [value] => elementFormatter value
       | list =>
         FE.Sequence prefixIfNotNull ::
         FE.Sequence (SMLFormat.BasicFormatters.format_list
                        (elementFormatter, separator) list) ::
         suffixIfNotNull

 (*%
  * @params(bindsep, itemsep, prefixIfNotNull, suffixIfNotNull)
  * @formatter(list)  formatListWithEnclosure
  *)
 type ('key, 'elem) map =
     (*%
      * @format(field fields)
      *           fields(field)(itemsep, prefixIfNotNull, suffixIfNotNull)
      * @format:field(key * element) key bindsep element
      *)
     ('key * 'elem) list

 (*%
  * @params(bindsep, itemsep, prefixIfNotNull, suffixIfNotNull)
  * @formatter(listWithEncousure)  formatListWithEnclosure
  * @formatter(Symbol.symbol)  Symbol.format_symbol
  *)
 type 'a varenvSymbolWithEnclosure =
     (*%
      * @format(field fields:listWithEncousure)
      *           fields(field)(itemsep, prefixIfNotNull, suffixIfNotNull)
      * @format:field(symbol * ty) symbol bindsep ty
      *)
     (Symbol.symbol * 'a) list

 (*%
  * @params(lparen, bindsep,itemsep,rparen)
  * @formatter(listWithEncousure)  formatListWithEnclosure
  * @formatter(Symbol.symbol)  Symbol.format_symbol
  *)
 type 'a varenvSymbol =
     (*%
        @format(field fields)
          fields:listWithEncousure(field)(itemsep,lparen,rparen) 
        @format:field(symbol * ty) 
          { 2[ symbol bindsep ty ] }
      *)
     (Symbol.symbol * 'a) list

  fun formatSymbolMap (elementFormatter,lparen, bindsep,itemsep, rparen) smap =
      format_varenvSymbol
        (elementFormatter,lparen, bindsep,itemsep, rparen) 
        (ListSorter.sort 
           (fn ((s1, _), (s2, _)) => Symbol.compare(s1,s2))
           (SymbolEnv.listItemsi smap))

 (*%
  * @params(sname, lparen, itemsep, rparen)
  * @formatter(formatListWithEnclosure)  formatListWithEnclosure
  * @formatter(Symbol.symbol)  Symbol.format_symbol
  *)
 type 'a genericSymbolVarenv =
     (*%
        @format(field fields)
          fields:formatListWithEnclosure(field)(itemsep, lparen, rparen) 
        @format:field(symbol * ty) 
          ty()(sname,,symbol)
      *)
     (Symbol.symbol * 'a) list

  fun formatGenericSymbolMap
        (elementFormatter, sname, lparen, itemsep, rparen) smap =
      format_genericSymbolVarenv
        (elementFormatter, sname, lparen, itemsep, rparen)
        (ListSorter.sort 
           (fn ((s1, _), (s2, _)) => Symbol.compare(s1,s2))
           (SymbolEnv.listItemsi smap))

  fun formatSymbolMapWithEnclosure
          (
            elementFormatter,
            bindsep,
            itemsep,
            prefixIfNotNull,
            suffixIfNotNull
          )
          smap
    =
      format_varenvSymbolWithEnclosure
      (elementFormatter, bindsep, itemsep, prefixIfNotNull, suffixIfNotNull)
        (ListSorter.sort 
           (fn ((s1, _), (s2, _)) => Symbol.compare(s1,s2))
           (SymbolEnv.listItemsi smap))

  fun formatPrependedOpt (formatter, prefixIfSome) =
      fn NONE => [FE.Term (0, "")]
       | SOME value => FE.Sequence prefixIfSome :: formatter value

  fun formatEnclosedOpt (formatter, prefixIfSome, suffixIfSome) =
      fn NONE => [FE.Term (0, "")]
       | SOME value => FE.Sequence prefixIfSome ::
                       FE.Sequence (formatter value) ::
                       suffixIfSome

  fun formatOptWithDefault (formatter, default) =
      fn NONE => default
       | SOME value => formatter value

  fun formatBinaryChoice (ifTrue, ifFalse) value =
      if value then ifTrue else ifFalse


  (***************************************************************************)

end
